home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Programmer Disk
/
The Programmer Disk (Microforum).iso
/
xpro
/
pascal2
/
pro7
/
walktree.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-11-01
|
5KB
|
183 lines
{TITLE: TREE-WALKING PROGRAM
I'd asked (in pascal/turbo #1671) about a code fragment to walk the DOS
directory tree. I got several suggestions, but no program, so I write one,
and here it is. Thanks to those who helped!
}
(*************************************************************************)
PROGRAM WalkDirectoryTree;
{$p256,g256}
{ This program uses recursion and DOS calls to "walk" the DOS subdirectory
tree. Beginning at some starting directory, it returns the name of every
subdirectory and file in the tree structure.
It is, of course, not good for anything by itself, but may be a valuable
component of a SWEEP program or other utility. All dire warnings apply.
Thanks to JimKeo, who provided the DOS function call code (see pascal/
source #7) which make up the bulk of the program, and to DNanian, who
reminded me that Pascal supports recursion.
--Bob Brown
September, 1986
}
TYPE
AnyString = STRING[255];
PathString= STRING[64];
FileString= STRING[12];
Regset = RECORD
CASE INTEGER OF
0: (ax,bx,cx,dx,bp,si,di,ds,es,flags:INTEGER);
1: (al,ah,bl,bh,cl,ch,dl,dh:BYTE);
END;
FileInfo= RECORD
FindInfo: ARRAY[1..21] OF BYTE;
Attr: BYTE;
Time, Date, SizeLo, SizeHi: INTEGER;
FileName: ARRAY[0..12] of CHAR;
END;
DTAPtr = ^FileInfo;
VAR
CurrentPath: PathString;
PROCEDURE GetDTA(VAR p); {from JimKeo}
VAR
Regs: RegSet;
PP: ^FileInfo ABSOLUTE p;
BEGIN {GetDTA}
Regs.ah := $2f;
MsDOS(Regs);
PP := ptr(Regs.es, Regs.bx);
END;
PROCEDURE SetDTA(P:DTAPtr); {from JimKeo}
VAR
Regs: RegSet;
BEGIN {SetDTA}
Regs.ah := $1a;
Regs.ds := SEG(P^);
Regs.dx := OFS(P^);
MsDOS(Regs);
END; {SetDTA}
FUNCTION AsciiZ2S(VAR AsciiZ):AnyString; {from JimKeo}
VAR
A: ARRAY[0..255] OF CHAR ABSOLUTE AsciiZ;
I: INTEGER;
S: AnyString;
BEGIN
I := 0;
WHILE A[I] <> CHR(0) DO
I := SUCC(I);
{$R-}
S[0] := CHR(I);
MOVE (A,S[1],I);
{$R+}
AsciiZ2S := S;
END; {AsciiZ2S}
FUNCTION FindFirst(Name:PathString; Attr:INTEGER; VAR info:FileInfo):BOOLEAN;
VAR {from JimKeo}
Regs: RegSet;
Save: ^FileInfo;
BEGIN {FindFirst}
GetDTA(Save);
SetDTA(addr(info));
Regs.ah := $4E;
Regs.ds := seg(Name);
Regs.dx := ofs(Name)+1; {+1 to get past length byte}
Name := Name + #0;
Regs.cx := Attr;
MsDos(Regs);
FindFirst := (Regs.flags AND $01) = 0;
SetDTA (Save);
END; {FindFirst}
FUNCTION FindNext(VAR info:FileInfo):BOOLEAN; {from JimKeo}
VAR
Regs: RegSet;
Save: ^FileInfo;
BEGIN;
GetDTA(Save);
SetDTA(addr(info));
Regs.ah := $4f;
MsDos(Regs);
FindNext := (Regs.Flags AND $01) = 0;
SetDTA(Save);
END;
FUNCTION DosVersion: INTEGER; {from JimKeo}
VAR
Regs: RegSet;
BEGIN {DosVersion}
Regs.ah := $30;
MSDos(Regs);
DosVersion := Regs.al*100+Regs.ah;
END;
FUNCTION FullFileName (PathName:PathString; FileName:FileString):PathString;
VAR
S: PathString;
I: INTEGER;
BEGIN
S := PathName;
I := Length(S);
IF POS('\',S) > 0 THEN {If there's a pathname, find the end}
BEGIN
WHILE S[I] <> '\' DO
I := PRED(I);
END
ELSE
I := POS(':',S);
IF I = 0 THEN
S := ''
ELSE
DELETE (S,I+1,(Length(S)-I)); {Delete wildcard stuff if any}
FullFileName := S + FileName;
END;
PROCEDURE WalkTree (BeginningPath:PathString);
VAR
FileArea: FileInfo;
FileFound: BOOLEAN;
NewPath: PathString;
PROCEDURE ProcessDirEntry;
BEGIN
NewPath := FullFileName(BeginningPath,AsciiZ2S(FileArea.FileName));
IF (((FileArea.Attr AND $10) <> 0)
AND (FileArea.FileName[0] <> '.')) THEN
BEGIN
WRITELN ('*** SUBDIRECTORY *** ',NewPath);
WalkTree (NewPath+'\*.*');
END
ELSE
WRITELN(NewPath);
END;
BEGIN {WalkTree}
FileFound := FindFirst (BeginningPath,$16,FileArea);
IF FileFound THEN
ProcessDirEntry;
WHILE FileFound DO
BEGIN
FileFound := FindNext(FileArea);
IF FileFound THEN
ProcessDirEntry;
END;
END; {WalkTree}
BEGIN {Main}
IF (DosVersion < 200) THEN
BEGIN
WRITELN('Valid only for DOS Version 2.0 and up');
HALT;
END;
CurrentPath := 'c:\*.*'; {----- Where to begin }
WalkTree (CurrentPath);
END.